心理ネットワークを用いた
シミュレーション研究

計算論的臨床心理学サマースクール2025

専修大学大学院文学研究科心理学専攻修士課程2年
大水 拓海

2025-08-07

自己紹介

大水拓海(おおみず たくみ)

所属

専修大学大学院文学研究科心理学専攻修士課程2年

研究テーマ・関心

心理療法の作用機序,感情粒度,心理ネットワーク,
シミュレーション,能動的推論

個人HP

心理ネットワーク”シミュレーション”

なぜネットワークからシミュレーションを行うか？

  • 実際の臨床データを使用することの困難さ(入手，使用)

  • 侵襲性の問題を超えて介入を試す，予測する

  • 新たな仮説の生成

ネットワークシミュレーションの実例

Cramer et al (2016)

ネットワークの結合を強めるパラメータ\(c\)の値が症状全体の活性化を左右する

\[A^{t}_{i} = \sum^{J}_{j=1} cW_{ij}X^{t-1}_j\tag{1}\]

\[P(X^{t}_{i} = 1) = \frac{1}{1+e^{b_{i}}-A^{t}_i} \tag{2}\]

Omizu & Kunisato(2025)

Omizu & Kunisato(2025)

  • Cramerのモデルでは症状のみの接続の強さに着目

  • 実データにおいて症状が改善しても接続が強まっていることが報告(Höller et al, 2022)



→心理療法などの治療的な要素を入れて拡張することで，ネットワークの中でどの症状を標的にすれば大きな治療効果が得られるかシミュレーションできる

Omizu & Kunisato(2025)：単独症状

Omizu & Kunisato(2025)：複数症状

psynetsim パッケージ

シミュレーションを実際に行ってみる

psynetsim パッケージ

  • ネットワークシミュレーションを実行する関数を
    パッケージにしてまとめました

  • ご自身のRコンソールに以下をコピペして，パッケージをインストールしてください

remotes::install_github("TakumiOmizu/psynetsim")
library(psynetsim)

psynetsim パッケージ

  • W_init：第1引数。症状ネットワークの重み。

  • b_init：第2引数。各ノードの活性化閾値。

  • target：どのノードを標的とするかを選択するリスト/ベクトル。介入するノードは1，介入しないノードは0にする。

上記は必須の引数です。
他にもいろいろオプションがあります。

?simulate_treatment_network

psynetsim パッケージ

仮想データの作成

# Example data for a 6-symptom network
set.seed(456)
weight_6 <- matrix(rnorm(6*6, mean = 0.2, sd = 0.08), nrow = 6, ncol = 6)
diag(weight_6) <- 0
weight_6[upper.tri(weight_6)] <- t(weight_6)[upper.tri(weight_6)]
print(weight_6)
           [,1]      [,2]      [,3]       [,4]       [,5]      [,6]
[1,] 0.00000000 0.2497420 0.2640700 0.08888861 0.14285145 0.1740751
[2,] 0.24974204 0.0000000 0.2805882 0.24585877 0.12673516 0.3048878
[3,] 0.26406997 0.2805882 0.0000000 0.35578851 0.33895489 0.2309987
[4,] 0.08888861 0.2458588 0.3557885 0.00000000 0.08585358 0.2166589
[5,] 0.14285145 0.1267352 0.3389549 0.08585358 0.00000000 0.1128498
[6,] 0.17407512 0.3048878 0.2309987 0.21665887 0.11284977 0.0000000
threshold_6 <- data.frame(threshold = rnorm(6, mean = 0.3, sd = 0.05))
print(threshold_6)
  threshold
1 0.2669698
2 0.2929874
3 0.2788010
4 0.2980632
5 0.2985529
6 0.3196519

psynetsim パッケージ

ターゲットとノード名の設定

target_list_6 <- list(symptom1 = 1, symptom2 = 0, symptom3 = 1,
                      symptom4 = 0, symptom5 = 0, symptom6 = 1)
custom_symptom_names_6 <- c("Anxiety", "Sadness", "Fatigue",
                            "Insomnia", "Irritability", "Pain")

シミュレーションの実行

# Run the simulation with custom parameters
sim_results <- simulate_treatment_network(
  W_init = weight_6,
  b_init = threshold_6$threshold,
  target = target_list_6,
  connectivity = 1.2,
  edge_between_TC = 0.8,
  weight_bias = 1.2,
  TB = 1,
  trial = 10, # Example: Overriding default 10
  baseline_iteration = 10, # Example: Overriding default 10
  num_TC = 5, # Example: Overriding default 5
  TC_iteration_per_component = 10, # Example: Overriding default 10
  follow_up_iteration = 10, # Example: Overriding default 10
  symptom_name = custom_symptom_names_6
)

psynetsim パッケージ

シミュレーション結果

ネットワークシミュレーションを試そう！

先ほど推定したIsing modelの重みと閾値を使って，シミュレーション

  • 単独の症状を標的とした場合，どの症状への介入が最も効果的か？

  • 複数の症状を標的とした場合，どのような組み合わせが効果的か？

  • 症状を悪化させてしまう組み合わせはあるか？

  • その他，どんな条件だとどんなことが起きそうか？

ネットワークシミュレーションを試そう！

不安のオープンデータをダウンロードしてカレントディレクトリに保存する。

# Isingのデータを使ってシミュレーションする
library(tidyverse)
library(foreign)
library(bootnet)
library(qgraph)
library(IsingFit)

# データの読み込み
data <- read.spss("data/pone.0182162.s004.sav", 
                  to.data.frame=TRUE)
# データの整理(GADに絞って実行)
data_gad <- data %>% 
  rename(gad7a = S_GAD7_a, gad7b = S_GAD7_b, 
         gad7c = S_GAD7_c, gad7d = S_GAD7_d, 
         gad7e = S_GAD7_e, gad7f = S_GAD7_f, 
         gad7g = S_GAD7_g) %>% 
  select(gad7a, gad7b, gad7c, gad7d, gad7e, gad7f, gad7g)

data_gad %>% head()

ネットワークシミュレーションを試そう！

  gad7a gad7b gad7c gad7d gad7e gad7f gad7g
1     1     0     0     0     3     2     2
2     0     0     0     0     0     1     0
3     0     0     0     0     0     1     0
4     0     0     0     0     0     0     0
5     0     0     0     0     0     1     0
6     3     2     1     3     3     1     1

ネットワークシミュレーションを試そう！

#0以外を1に変換
y_ifelse <- ifelse(data_gad < 1, 0, 1) %>% na.omit()

y_ifelse %>% head()

res <- IsingFit(y_ifelse, family = "binomial", AND = TRUE, gamma = 0.25, plot
         = TRUE, progressbar = TRUE, min_sum = -Inf,
         lowerbound.lambda = NA)

res$weiadj 
res$thresholds

ネットワークシミュレーションを試そう！

          gad7a     gad7b     gad7c     gad7d     gad7e     gad7f     gad7g
gad7a 0.0000000 1.0439830 0.7587986 1.0914346 0.4889163 0.3086700 1.1322104
gad7b 1.0439830 0.0000000 1.9008079 0.9338190 0.3776924 0.3382065 0.9932868
gad7c 0.7587986 1.9008079 0.0000000 0.9125330 0.0000000 0.5227649 0.8279194
gad7d 1.0914346 0.9338190 0.9125330 0.0000000 1.3452892 0.8934315 0.2867852
gad7e 0.4889163 0.3776924 0.0000000 1.3452892 0.0000000 0.9192592 0.6740093
gad7f 0.3086700 0.3382065 0.5227649 0.8934315 0.9192592 0.0000000 0.3999585
gad7g 1.1322104 0.9932868 0.8279194 0.2867852 0.6740093 0.3999585 0.0000000
    gad7a     gad7b     gad7c     gad7d     gad7e     gad7f     gad7g 
-1.815663 -3.516485 -2.132813 -1.795428 -3.007363 -1.267546 -2.971828

ネットワークシミュレーションを試そう！

library(psynetsim)
qgraph(res$weiadj, posCol = "blue", color = "lightblue")

ネットワークシミュレーションを試そう！

ネットワークシミュレーションを試そう！

#推定したデータを使ってシミュレーション
simulate_treatment_network(res$weiadj, 
                           res$thresholds,
                           connectivity = 1.3,
                           target = c(1,1,1,1,1,1,1),
                           num_TC = 10,
                           edge_between_TC = 2,
                           weight_bias = 1)

ネットワークシミュレーションを試そう！

$result_plot
TableGrob (1 x 2) "arrange": 2 grobs
  z     cells    name           grob
1 1 (1-1,1-1) arrange gtable[layout]
2 2 (1-1,2-2) arrange gtable[layout]

$result_text
[1] "The mean value of symptom at the final step(t=120). = 0.557\nThe mean value of treatment component at the final step(t=120). = 1.000\nThe SD value of symptom at the final step(t=120). = 0.218\nThe SD value of treatment component at the final step(t=120). = 0.000"